home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / Tails / IUK.pm next >
Encoding:
Perl POD Document  |  2012-11-13  |  10.9 KB  |  408 lines
  1. =head1 NAME
  2.  
  3. Tails::IUK - Incremental Upgrade Kit class
  4.  
  5. =cut
  6.  
  7. package Tails::IUK;
  8.  
  9. use Moose;
  10. use MooseX::Method::Signatures;
  11. use MooseX::Types::Moose qw( :all );
  12. use MooseX::Types::Path::Class;
  13. use MooseX::Has::Sugar::Saccharin;
  14.  
  15. our $VERSION = '0.3.7'; # VERSION
  16.  
  17. with 'MooseX::Getopt::Dashes';
  18.  
  19. use 5.10.0;
  20. use namespace::autoclean;
  21. use warnings FATAL => 'all';
  22.  
  23. use autodie qw(:all);
  24. use Carp;
  25. use Carp::Assert;
  26. use Cwd;
  27. use Data::Dumper;
  28. use Device::Cdio::ISO9660;
  29. use Device::Cdio::ISO9660::IFS;
  30. use English qw{-no_match_vars};
  31. use File::Basename;
  32. use File::Copy;
  33. use File::Spec::Functions;
  34. use File::Temp qw{tempdir tempfile};
  35. use Path::Class;
  36. use Tails::IUK::Utils qw{extract_file_from_iso extract_here_file_from_iso run_as_root};
  37. use Try::Tiny;
  38. use YAML::Any;
  39.  
  40.  
  41. =head1 ATTRIBUTES
  42.  
  43. =cut
  44.  
  45. has 'format_version' => lazy_build ro Str;
  46. has 'squashfs_diff_name' => required ro Str;
  47. has 'squashfs_diff'  => coerce lazy_build ro 'Path::Class::File';
  48. has 'delete_files'   => lazy_build ro 'ArrayRef[Str]';
  49. foreach (qw{old_iso new_iso}) {
  50.     has $_ => required ro Str;
  51. }
  52. has 'outfile' => required coerce lazy_build ro 'Path::Class::File';
  53. has 'new_kernels' => lazy_build ro 'ArrayRef[Str]';
  54. has 'tarballs' => lazy_build ro 'ArrayRef[Str]';
  55. has 'tempdir' => lazy_build ro 'Path::Class::Dir';
  56. has 'tar_options' =>
  57.     lazy_build ro 'ArrayRef[Str]',
  58.     traits => ['Array'],
  59.     handles => {
  60.         list_tar_options => 'elements',
  61.     };
  62.  
  63.  
  64. =head1 FUNCTIONS
  65.  
  66. =cut
  67.  
  68. =head2 missing_files_in_isos
  69.  
  70. Returns the list of the basename of files present in $dir in $iso1,
  71. and missing in $dir in $iso2, non-recursively.
  72.  
  73. Some was adapted from File::DirCompare:
  74.  
  75.     Copyright 2006-2007 by Gavin Carr
  76.     This library is free software; you can redistribute it and/or modify it
  77.     under the same terms as Perl itself.
  78.  
  79. =cut
  80. sub missing_files_in_isos {
  81.     my $iso1 = shift;
  82.     my $iso2 = shift;
  83.     my $dir  = shift;
  84.  
  85.     my $read_iso_dir = sub {
  86.         my $iso = shift;
  87.         my $dir = shift;
  88.         my $iso_obj = Device::Cdio::ISO9660::IFS->new(-source => $iso);
  89.         map {
  90.             Device::Cdio::ISO9660::name_translate($_->{filename});
  91.         } $iso_obj->readdir($dir);
  92.     };
  93.  
  94.     my @res;
  95.  
  96.     # List $dir1 and $dir2
  97.     my (%d1, %d2);
  98.     $d1{basename $_} = 1 foreach $read_iso_dir->($iso1, $dir);
  99.     $d2{basename $_} = 1 foreach $read_iso_dir->($iso2, $dir);
  100.  
  101.     # Prune dot dirs
  102.     delete $d1{''} if $d1{''};
  103.     delete $d1{curdir()} if $d1{curdir()};
  104.     delete $d1{updir()}  if $d1{updir()};
  105.     delete $d2{''} if $d2{''};
  106.     delete $d2{curdir()} if $d2{curdir()};
  107.     delete $d2{updir()}  if $d2{updir()};
  108.  
  109.     my %u;
  110.     for my $f (map { $u{$_}++ == 0 ? $_ : () } sort(keys(%d1), keys(%d2))) {
  111.         push @res, $f unless $d2{$f};
  112.     }
  113.  
  114.     return map { catfile($dir, $_) } @res;
  115. }
  116.  
  117. =head2 updated_or_new_files_in_isos
  118.  
  119. Returns the list of the basename of files new or updated in $dir in $iso1,
  120. wrt. $iso2, non-recursively.
  121.  
  122. Some was adapted from File::DirCompare:
  123.  
  124.     Copyright 2006-2007 by Gavin Carr
  125.     This library is free software; you can redistribute it and/or modify it
  126.     under the same terms as Perl itself.
  127.  
  128. =cut
  129. sub updated_or_new_files_in_isos {
  130.     my $iso1 = shift;
  131.     my $iso2 = shift;
  132.     my $dir  = shift;
  133.     my $whitelist_patterns = shift;
  134.  
  135.     assert(-e $iso1);
  136.     assert(-e $iso2);
  137.  
  138.     my $iso1_obj = Device::Cdio::ISO9660::IFS->new(-source => $iso1);
  139.     my $iso2_obj = Device::Cdio::ISO9660::IFS->new(-source => $iso2);
  140.  
  141.     my $read_iso_dir = sub {
  142.         my $iso_obj = shift;
  143.         my $dir = shift;
  144.  
  145.         assert(defined($iso_obj));
  146.         my @wanted_files;
  147.         my @files_in_dir;
  148.         try { @files_in_dir = $iso_obj->readdir($dir) };
  149.         foreach (@files_in_dir) {
  150.             my $filename = Device::Cdio::ISO9660::name_translate($_->{filename});
  151.             foreach my $re (@{$whitelist_patterns}) {
  152.                 if ($filename =~ $re) {
  153.                     push @wanted_files, $filename;
  154.                     last;
  155.                 }
  156.             }
  157.         }
  158.         return @wanted_files;
  159.     };
  160.  
  161.     my @res;
  162.  
  163.     # List $dir in $iso1 and $iso2
  164.     my (%d1, %d2);
  165.     $d1{basename $_} = 1 foreach $read_iso_dir->($iso1_obj, $dir);
  166.     $d2{basename $_} = 1 foreach $read_iso_dir->($iso2_obj, $dir);
  167.  
  168.     # Prune dot dirs
  169.     delete $d1{''} if $d1{''};
  170.     delete $d1{curdir()} if $d1{curdir()};
  171.     delete $d1{updir()}  if $d1{updir()};
  172.     delete $d2{''} if $d2{''};
  173.     delete $d2{curdir()} if $d2{curdir()};
  174.     delete $d2{updir()}  if $d2{updir()};
  175.  
  176.     my %u;
  177.     for my $f (map { $u{$_}++ == 0 ? $_ : () } sort(keys(%d1), keys(%d2))) {
  178.         # only in $iso1
  179.         next unless $d2{$f};
  180.  
  181.         # only in $iso2
  182.         unless ($d1{$f}) {
  183.             push @res, $f;
  184.             next;
  185.         }
  186.  
  187.         # in both
  188.         my $stat1 = $iso1_obj->stat(catfile($dir, $f));
  189.         my $stat2 = $iso2_obj->stat(catfile($dir, $f));
  190.  
  191.         croak "File $f in $iso1 is a directory." if $stat1->{is_dir};
  192.         croak "File $f in $iso2 is a directory." if $stat2->{is_dir};
  193.  
  194.         push @res, $f if
  195.             extract_file_from_iso(catfile($dir, $f), $iso1)
  196.                 ne
  197.             extract_file_from_iso(catfile($dir, $f), $iso2);
  198.     }
  199.  
  200.     return map { file($dir, $_)->basename } @res;
  201. }
  202.  
  203.  
  204. =head1 METHODS
  205.  
  206. =cut
  207.  
  208. method _build_tempdir { dir(tempdir()); }
  209. method _build_format_version { "1"; }
  210. method _build_tar_options { [qw{--numeric-owner --owner=root --group=root}]; }
  211. method _build_squashfs_diff  {
  212.     my $tempdir = $self->tempdir;
  213.  
  214.     my $old_iso_mount      = dir($tempdir, 'old_iso');
  215.     my $new_iso_mount      = dir($tempdir, 'new_iso');
  216.     my $old_squashfs_mount = dir($tempdir, 'old_squashfs');
  217.     my $new_squashfs_mount = dir($tempdir, 'new_squashfs');
  218.     my $tmpfs              = dir($tempdir, 'tmpfs');
  219.     my $union              = dir($tempdir, 'union');
  220.  
  221.     for my $dir ($old_iso_mount, $new_iso_mount, $old_squashfs_mount, $new_squashfs_mount, $tmpfs, $union) {
  222.         mkdir $dir;
  223.     }
  224.  
  225.     run_as_root("mount", "-o", "loop,ro", $self->old_iso, $old_iso_mount);
  226.     my $old_squashfs = file($old_iso_mount, 'live', 'filesystem.squashfs');
  227.     croak "SquashFS '$old_squashfs' not found in '$old_iso_mount'" unless -e $old_squashfs;
  228.     run_as_root(qw{mount -t squashfs -o loop}, $old_squashfs, $old_squashfs_mount);
  229.  
  230.     run_as_root("mount", "-o", "loop,ro", $self->new_iso, $new_iso_mount);
  231.     my $new_squashfs = file($new_iso_mount, 'live', 'filesystem.squashfs');
  232.     croak "SquashFS '$new_squashfs' not found in '$new_iso_mount'" unless -e $new_squashfs;
  233.     run_as_root(qw{mount -t squashfs -o loop}, $new_squashfs, $new_squashfs_mount);
  234.  
  235.     run_as_root(qw{mount -t tmpfs tmpfs}, $tmpfs);
  236.  
  237.     run_as_root(
  238.         qw{mount -t aufs},
  239.         "-o", sprintf("br=%s=rw:%s=ro", $tmpfs, $old_squashfs_mount),
  240.         "none", $union
  241.     );
  242.  
  243.     run_as_root(
  244.         "rsync", "--archive", "--quiet", "--delete-after",
  245.         sprintf("%s/", dir($new_squashfs_mount)),
  246.         sprintf("%s/", dir($union)),
  247.     );
  248.  
  249.     my ($squashfs_diff_fh, $squashfs_diff_filename) = tempfile();
  250.  
  251.     run_as_root(
  252.         qw{sudo -n mksquashfs},
  253.         $tmpfs,
  254.         $squashfs_diff_filename,
  255.         qw{-no-progress -noappend -comp xz}
  256.     );
  257.  
  258.     foreach ($union, $tmpfs, $new_squashfs_mount, $new_iso_mount, $old_squashfs_mount, $old_iso_mount) {
  259.         run_as_root("umount", $_);
  260.     }
  261.  
  262.     return file($squashfs_diff_filename);
  263. }
  264.  
  265. method _build_delete_files {
  266.     my $old_iso_obj = Device::Cdio::ISO9660::IFS->new(-source=>$self->old_iso);
  267.     my $new_iso_obj = Device::Cdio::ISO9660::IFS->new(-source=>$self->new_iso);
  268.     my @delete_files;
  269.     for (qw{isolinux live syslinux tails}) {
  270.         push @delete_files,
  271.             missing_files_in_isos($self->old_iso, $self->new_iso, $_);
  272.     }
  273.     return \@delete_files;
  274. }
  275.  
  276. method _build_new_kernels {
  277.     my @new_kernels =
  278.         updated_or_new_files_in_isos(
  279.             $self->old_iso,
  280.             $self->new_iso,
  281.             'live',
  282.             [
  283.                 qr{^ vmlinuz [[:digit:]]* $}xms,
  284.                 qr{^ initrd  [[:digit:]]* [.] img $}xms,
  285.             ],
  286.         );
  287.     return \@new_kernels;
  288. }
  289.  
  290. method write_boot_tarball {
  291.     my $orig_cwd = getcwd;
  292.     my $boot_files_tempdir = tempdir(CLEANUP => 1);
  293.  
  294.     chdir $boot_files_tempdir;
  295.     extract_here_file_from_iso('isolinux', $self->new_iso);
  296.  
  297.     chmod(0755, 'isolinux');
  298.     chmod(0644, glob('isolinux/*'));
  299.  
  300.     rename 'isolinux', 'syslinux';
  301.     rename 'syslinux/isolinux.cfg', 'syslinux/syslinux.cfg';
  302.  
  303.     foreach my $file (glob('syslinux/*')) {
  304.         my $content = file($file)->slurp;
  305.         $content =~ s{/isolinux/}{/syslinux/}gxms;
  306.         my ($temp_fh, $temp_filename) = tempfile;
  307.         print $temp_fh $content;
  308.         close $temp_fh;
  309.         rename $temp_filename, $file;
  310.     }
  311.  
  312.     system(
  313.         qw{tar -cj}, $self->list_tar_options,
  314.         '-f', file($self->tempdir, 'boot.tar.bz2'), 'syslinux',
  315.     );
  316.  
  317.     chdir $orig_cwd;
  318.  
  319.     return;
  320. }
  321.  
  322. method write_system_tarball {
  323.     my $tarball = file($self->tempdir, 'system.tar');
  324.  
  325.     chdir $self->squashfs_diff->dir;
  326.     my $destname = file('live', $self->squashfs_diff_name);
  327.     my $destdir  = file($destname)->dir;
  328.     $destdir->mkpath;
  329.     -d $destdir or croak(sprintf("Could not make directory '%s': $!"), $destdir);
  330.     copy($self->squashfs_diff->basename, $destname)
  331.         or croak(
  332.             sprintf(
  333.                 "Could not copy '%s' to '%s': $!",
  334.                 $self->squashfs_diff->basename, $destname
  335.             )
  336.         );
  337.     system(qw{tar --create}, $self->list_tar_options, '-f', $tarball, $destname);
  338.     unlink $destname;
  339.  
  340.     my $new_kernels_tempdir = tempdir(CLEANUP => 1);
  341.     chdir $new_kernels_tempdir;
  342.     for my $new_kernel (@{$self->new_kernels}) {
  343.         my $new_kernel_rel = file('live', $new_kernel);
  344.         my $new_kernel_abs = file($new_kernels_tempdir, $new_kernel_rel);
  345.         $new_kernel_abs->dir->mkpath;
  346.         extract_here_file_from_iso($new_kernel_rel, $self->new_iso);
  347.         system(
  348.             qw{tar --append}, $self->list_tar_options, '-f', $tarball,
  349.             $new_kernel_rel
  350.         );
  351.     }
  352.  
  353.     chdir $self->tempdir;  # allow temp dirs cleanup
  354.  
  355.     return;
  356. }
  357.  
  358. method _build_tarballs {
  359.     $self->write_boot_tarball;
  360.     $self->write_system_tarball;
  361.     return [ qw{boot.tar.bz2 system.tar} ];
  362. }
  363.  
  364. method saveas ($outfile_name) {
  365.     my $orig_cwd = getcwd;
  366.     my $fh;
  367.     chdir $self->tempdir;
  368.  
  369.     $fh = file('FORMAT')->openw;
  370.     print $fh $self->format_version;
  371.     close $fh;
  372.  
  373.     $fh = file('control.yml')->openw;
  374.     print $fh YAML::Any::Dump({
  375.         delete_files => $self->delete_files,
  376.     });
  377.     close $fh;
  378.  
  379.     chdir $self->tempdir;
  380.     system(
  381.         qw{tar --create}, $self->list_tar_options, '-f', $outfile_name,
  382.         qw{FORMAT control.yml}
  383.     );
  384.  
  385.     for (@{$self->tarballs}) {
  386.         chdir file($_)->dir;
  387.         system(
  388.             qw{tar --append}, $self->list_tar_options, '-f', $outfile_name,
  389.             file($_)->basename
  390.         );
  391.     }
  392.  
  393.     chdir $orig_cwd;  # allow temp dirs cleanup
  394.  
  395.     return;
  396. }
  397.  
  398. method save () {
  399.     $self->saveas($self->outfile);
  400. }
  401.  
  402. method run () {
  403.     $self->save;
  404. }
  405.  
  406. no Moose;
  407. 1;
  408.